home *** CD-ROM | disk | FTP | other *** search
/ Die Speccy' 97 / Die Speccy' 97.iso / amiga_system / the_aminet / comm / cnet / cnet_who.lha / Who / Short < prev   
Text File  |  1995-10-15  |  4KB  |  49 lines
  1. /**************************************************************************\
  2.             $VER: CNet Short WHO, v2.51 (15-Oct-95) by Dotoran!
  3. \**************************************************************************/
  4. options results;signal on SYNTAX;signal on ERROR;signal on IOERR
  5. tr=transmit;se=sendstring;gu=getuser;gs=getscratch;mg=maygetchar
  6. a='rexxsupport.library';if ~show('l',a) then if ~addlib(a,0,-30) then exit
  7. changewhere 'Short WHO';low=0;gu 2225094;high=result;gu 23;myport=result;pd=2424286;gu 55;help=result
  8. gu 2107337;idle=result;gu 1100661;conf=BitTST(d2c(result,4),7);call CONFIG;gu 1302307;arg=upper(result)
  9. if arg='' then args=low'-'high;if arg>''&arg~='?'&left(arg,1)~='C' then call ARGS
  10. tot=high;call PARSER(args,0,high);helpT='n1cfShort Whoc6, vcb2c6.cb50 c6by cdDotorann2'
  11. helpT=helpT'c7Formatce:  caW c7[c6portce# c6pce#cb-c6pce# c6pce#cb,c6pce# cb-c6pce# c6pce#cb-c7]'
  12. if totpit=0 then arg='?';if arg='?' then do;tr helpT;exit;end;if left(arg,1)='C'&conf=1 then do;se 'n1c3Loading z4c7SHORTz0 c3who config...#0pfiles:who/Config}';exit;end
  13.  
  14. v1=1;v4=0;v5=0;v6=0;loS=0;hiS=0;v7=1;if v7=1 then tr 'f1'
  15.  
  16. tr "z6c4Portz0 z6c4User Handle         z0 z6c4Where            z0";call MGC
  17. tr "cc==== cc==================== cc================="
  18. do ii=1 to totpit;i=subword(it.0,ii,1);if index(' 'it.0' ',i)=0 then iterate ii
  19.   if v6=1&ii=loS+1 then do;ii=hiS-1;iterate ii;end;port=i;st=' ';gu 1101630+i;a=d2c(result);call MGC
  20.   mu=BitTST(a,1);if mu=1 then st='m';hi=BitTST(a,0);if hi=1&myport~=i then st='h'
  21.   getportid i;id=result; getwhere i;where=left(result,17);gu pd+(i*4);zy=c2d(import(offset(null(),result+30),2))
  22.   call MINUTES(zy);iT=zz;if where='(offline)' then iterate ii;if id=-1&(idle=1|v4=1) then iterate ii
  23.   off=1630+myport;gu pd+(i*4);hidden=result+off;hide=BitTST(import(offset(null(),hidden),1),0)
  24.   muff=BitTST(import(offset(null(),hidden),1),1);gu 1200032;a=result
  25.   if hide=1&conf~=1 then do;zy=a+fake;id=-1;call MINUTES(zy);iT=zz;end
  26.   call MGC;if hide=1&conf~=1&v5=1 then iterate ii;if id>-1 then do;loadscratch id;savescratch (-id)
  27.   gu 1101333;con=BitTST(d2c(result,4),7);if v1=1&zy>5 then where='c9Idle ce'iT
  28.   if con=1&myport~=i then st='+';if muff=1&con=0&st~='h' then st='M';if hide=1&con=0 then st='H'
  29.   gs 1;handle=result;call MGC;end;if id=-1 then do;handle=l903;where=l107;if v1=1&where=l107 then where='c9Idle cb'iT;end
  30.   tr 'cf'right(port,2)' cb'st' ce'handle'.26}c9'where;call MGC
  31. end ii;tr 'cc'copies('=',43)' ';if help=3 then exit;if help=2 then do
  32.   tr 'cbm cf= cbMuffledcf, cbh cf= cbHiddencf, cb+ cf= cbConf. Control';exit;end
  33. tr "   cbm cc= cdYou're Muffling this Port.";if conf=1 then tr "   cbM cc= caThey're trying to Muffle You."
  34. tr "   cbh cc= cdYou're Hiding from this Port.";if conf=1 then tr "   cbH cc= caThey're trying to Hide from You."
  35. tr "   cb+ cc= c9User has Conference Control.";exit
  36. MGC:;mg;if result='NOCHAR' then return;else do;tr l1066;exit;end
  37. ARGS:;gu 1202244;total=result-1;args='';do i=0 to total+1;gu 1302307+(i*61);args=args||result' ';end i;return
  38. PARSER:;arg rng,min,max;it.='';c=0;it=translate(rng,'  ','.,');do a=1 to words(it);c=c+1;it.c=word(it,a)
  39.   if index(it.c,'-')>0 then do;parse var it.c x'-'y;if y='' then y=max;if x='' then x=min;if x>y then do;d=x;x=y;y=d;end
  40.   if x<min|y>max|~datatype(x,'W')|~datatype(y,'W') then do;c=c-1;iterate;end;do b=x to y;it.c=b;c=c+1;end;c=c-1;end
  41.   else if it.c<min|it.c>max|~datatype(it.c,'W') then do;c=c-1;iterate;end;end;totpit=c;do i=1 to c;it.0=it.0||it.i' ';end;return
  42. MINUTES:;arg m;t=right(m,1);m=m%10;hrs=m%60;mins=m-(hrs*60);if hrs=0 then zz=mins'.'t' ceMinutes';else zz=hrs'.'mins%6' cdHours';return
  43. CONFIG:;call open(f1,'pfiles:who/config.data','r');a=readln(f1);call close(f1);parse var a l107''l903''l1066''fake''junk;return
  44. SYNTAX:;ERROR:;IOERR:;e1=' Error: 'rc' ('errortext(rc)')Line: 'left(sigl,4)'File:';gu 1311992;a=result;gu 1311960;b=result
  45.   c='"'a||b'"';e2=e2' 'c;tr e1;tr e2;logentry e1;logentry e2;e=sourceline(sigl);do while e~=''
  46.   e3='Source: 'left(e,37);tr e3;logentry e3;e=substr(e,38);end;bufferflush;exit
  47. /** Last Edited: 15-Oct-95 ************************************************\
  48. \****************************************** Frontiers BBS (716)/823-9892 **/
  49.